perm filename P2S.OLD[LIB,LCS] blob sn#089341 filedate 1974-02-23 generic text, type T, neo UTF8
00100		DIMENSION I(70),J(70),KS(7),NQ(4)
00200		DATA KS/'B','E','A','D','G','C','F'/,NQ/'CLAR','BUZZ',
00210		1'BRIT','TOOT'/
00300	1	FORMAT(' TYPE FILE NAME ',$)
00400	2	FORMAT(A5)
00500	21	FORMAT(' TYPE OUTPUT NAME ',$)
00600		TYPE 1
00700		NR=1
00800		NEXT=0
00900		ACCEPT 2,NM
01000		TYPE 21
01100		ACCEPT 2,NMO
01200		CALL OFILE(21,NMO)
01300		WRITE(21,60)
01400		CALL IFILE(1,NM)
01500	300	WRITE(21,70)NQ(NR)
01600		TYPE 71,NQ(NR)
01700	70	FORMAT(A5,'/P3 NO;')
01800	71	FORMAT(1XA5,'/P3 NO;')
01900	30	READ(1,3)N,I
02000	3	FORMAT(I,70A1)
02100		KN=0
02200		M=1
02300		MORE=0
02400		DO 37 K=1,70
02500	37	IF(I(K).EQ.'*')MORE=-1
02600	36	DO 4 K=M,70
02700		NN=I(K)
02800		IF(NN.NE.'R'.AND.NN.NE.'X')GO TO 31
02900	C  FINDS 'REP' AND 'X'
03000		DO 32 MM=K,70
03100		NN=I(MM)
03200		IF(NN.NE.'/'.AND.NN.NE.'*'.AND.NN.NE.';')GO TO 32
03300		M=MM+1
03400		GO TO 36
03500	32	CONTINUE
03600	31	IF(NN.GE.'0'.AND.(K.EQ.1.OR.I(K-1).GT.0))GO TO 34
03700	C  FINDS TIME SIG.
03800	33	IF(NN.NE.'K')GO TO 35
03850		KQ=1
03900	334	KN=(I(K+KQ)-'0')/536870912
04000	C  FINDS THE NUMBER OF SHARPS OR FLATS
04050		KQ=K+KQ+1
04100		KAC=I(KQ)
04150		I(KQ)=' '
04200		GO TO 34
04210	333	KQ=0
04220		GO TO 334
04300	C  CATCHES TREB, BASS,ALTO,TENOR CLEFS AND MEASURE LINES.
04400	35	IF((NN.EQ.'B'.AND.I(K+1).EQ.'A').OR.(NN.EQ.'A'.AND.I(K+1).
04500		1 EQ.'L'))GO TO 34
04600		IF(NN.NE.'T'.AND.NN.NE.'M'.AND.NN.NE.'-')GO TO 4
04650	34	IF(I(K+1).LT.0)GO TO 333
04675	C  FOR NEW KEY SIG. (2F OR 3S, ETC.)
04700		IF(I(K-1).EQ.'/')I(K-1)=' '
04800		DO 44 JJ=K,70
04900		IF(I(JJ).EQ.'*'.OR.I(JJ).EQ.';')GO TO 46
05000	50	IF(I(JJ).EQ.'/')GO TO 46
05100	44	CONTINUE
05200	46	JJ=JJ-K
05250		IF(JJ.EQ.0)GO TO 4
05300		DO 45 N=K,70-JJ
05400	45	I(N)=I(N+JJ)
05500		GO TO 36
05600	4	CONTINUE
05700		K=0
05800	90	K=K+1
05900		NN=I(K)
06000		IF(KN.EQ.0)GO TO 11
06100		IF(NN.LT.'A'.OR.NN.GT.'G')GO TO 9
06200	55	K=K+1
06300		LN=I(K)
06400		IF(LN.NE.'N')GO TO 51
06500		I(K)=I(K-1)
06600		I(K-1)=' '
06700		GO TO 9
06800	51	IF(LN.EQ.'S'.OR.LN.EQ.'F')GO TO 9
06900		M=1
07000		MM=KN
07100		MMM=1
07200		IF(KAC.EQ.'F')GO TO 52
07300		MM=8-KN
07400		MMM=-1
07500		M=7
07600	52	DO 54 N=M,MM,MMM
07700		IF(NN.NE.KS(N))GO TO 54
07800		DO 53 NN=70,K+1,-1
07900	53	I(NN)=I(NN-1)
08000	C  OPENS UP SPACE FOR 'F' OR 'S'
08100		I(K)=KAC
08200		K=K+1
08300		GO TO 9
08400	54	CONTINUE
08500		GO TO 9
08600	11	IF(I(K).EQ.' ')GO TO 9
08700		IF(I(K).NE.'/')I(K-1)='/'
08800		GO TO 10
08900	9	IF(K.LT.70)GO TO 90
09000	6	FORMAT(70A1)
09100	64	FORMAT(1X70A1)
09200	61	FORMAT(' P2 RHY/',70A1)
09300	65	FORMAT('P2 RHY/',70A1)
09400	62	FORMAT('END;')
09500	63	FORMAT(' END;'/)
09600	60	FORMAT('QQQ')
09650	10	DO 101 K=1,70
09655	101	IF(I(K).NE.' '.AND.I(K).NE.'/')GO TO 103
09657	103	K=K-1
09660		DO 102 JJ=1,70-K
09665	102	I(JJ)=I(JJ+K)
09700		IF(MORE)GO TO 100
09800		WRITE(21,6)I
09900		TYPE 64,I
10000		GO TO 30
10100	100	DO 7 K=1,70
10200		IF(I(K).NE.'*')GO TO 7
10300		I(K)='/'
10400		I(K+1)='F'
10500		I(K+2)='I'
10600		I(K+3)='N'
10700		I(K+4)='*'
10800		GO TO 8
10900	7	CONTINUE
11000	8	I(70)=';'
11100		WRITE(21,6)I
11200		TYPE 64,I
11300	5	READ(1,3)N,J
11400		J(62)=';'
11500		IF(MORE.LE.0)GO TO 83
11600		TYPE 61,I,J
11700		WRITE(21,62)I,J
11800		GO TO 84
11900	83	TYPE 61,J
12000		TYPE 63
12100	80	WRITE(21,65)J
12200	84	WRITE(21,62)
12300	CCC	IF(NEXT)CALL EXIT
12400		NR=NR+1
12500		NEXT=-1
12600		DO 81 K=1,3
12700	81	READ(1,2,END=82)N
12800		GO TO 300
12900	82	END